COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002
C00007 ENDMK
C⊗;

(defun process-job (job)
       (prog2
	(restore-state job)
	(let ((state (job-active job)))
	     (arm)
	     (halt?)
	     (save-pc)
	     (caseq state
		    ((alive locked suicidal)
		     (incf (meter-active-cycles *meter*))
		     (funcall (pop *pc-stack*))
		     (cond ((null *pc-stack*)		;dead
			    (let ((jvd (job-value-dest job)))
				 (cond ((and jvd
					     (eq (value-dest-type jvd) 'empty))
					(push (job-value-dest job) *arg-stack*)
					(setf (job-active job) 'wait)
					(setf (job-waiter job) 'm-wait-value-dest)
					'wait)
				       ((or (and jvd
						 (return-message (job-value-dest job)
								 (top *arg-stack*)
								 (job-dest-id job)))
					    t)
					(let ((jl (job-list job)))
					     (cond (jl
						    (setf (job-list job) (job-list jl))
						    (setf (job-dest-id job) (job-dest-id jl))
						    (setf (job-value-dest job) (job-value-dest jl))
						    (restore-state jl)
						    (setf (job-active job) 'alive)
						    'alive)
						   (t (cond ((closure-expression job)
							     (setf (job-active job) 'ready))
							    (t 
							     (setf (job-active job) 'dead)))
						      'awakened)))))))
			   (t state)))  			;alive
		    (wait
		     (cond ((funcall (job-waiter job))
			    (incf (meter-active-cycles *meter*))
			    (setf (job-active job) 'alive)
			    (cond ((null *pc-stack*)		;dead
				   (cond ((job-value-dest job)
					  (return-message (job-value-dest job)
							  (top *arg-stack*)
							  (job-dest-id job))))
				   (let ((jl (job-list job)))
					(cond (jl
					       (setf (job-list job) (job-list jl))
					       (setf (job-dest-id job) (job-dest-id jl))
					       (setf (job-value-dest job) (job-value-dest jl))
					       (restore-state jl)
					       (setf (job-active job) 'alive)
					       'alive)
					      (t (cond ((closure-expression job)
							(setf (job-active job) 'ready))
						       (t 
							(setf (job-active job) 'dead)))
						 'awakened))))
				  (t 'alive)))  			;alive
			   (t 
			    (incf (meter-wait-cycles *meter*))
			    'wait)))				;alive
		    (dead 'dead)
		    (t (error "Process-job error" (closure-expression job)))))
	(save-state job))))))

(setq *armed* ())

(defun find-expr (expr)
       (*catch 'tag
	      (do ((pr (machine-processors *machine*) (cdr pr))
		   (n 0))
		  ((null pr) 
		   ())
		  (let ((first (car (qhead (processor-job-queue (car pr))))))
		       (do ((jobs (qhead (processor-job-queue (car pr)))
				  (cdr jobs))
			    (ojobs () (cdr jobs)))
			   ((eq (car ojobs) first)
			    t)
			   (cond ((member expr (arg-stack (car jobs)))
				  (*throw 'tag t))))))))

(defmacro arm ()
	  `(cond ((not *armed*)
		  (cond ((find-expr '(1+ i))
			 (print 'armed)
			 (setq *armed* t))))))

(defmacro save-pc ()
	  `(setq *saved-pc* (top *pc-stack*)))

(defmacro halt? ()
	  `(cond ((and *armed*
		       (not (find-expr '(1+ i))))
		  (break halted t))))